COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C***** FNCDM ***** LOAD WITH RDFNC, LOOK, AND NODM **************
C00025 ENDMK
C⊗;
C***** FNCDM ***** LOAD WITH RDFNC, LOOK, AND NODM **************
C  LOAD WITH -- RDFNC,NODM.MAC,LOOK.FAI 
C  THIS PROGRAM(FNCDM.F4) CREATES FUNCTIONS FOR THE MUSIC PROGRAM
C  USING 'SEG' OR 'SYNTH'.  UP TO 10 FUNCTIONS CAN BE STORED IN A
C  SINGLE FILE.  ONCE CREATED, THE FUNCTIONS MAY BE CHANGED
C  AND PUT BACK IN THE SAME FILE OR INTO A NEW ONE.
C  NO MORE THAN 50 INPUTS FOR ONE FUNCTION!

C TYPE 'C'(= CRUNCH)  FOR SPECIAL FEATURE SUBR TO COMBINE FUNCS 
C ALREADY MADE.      [MULT, ADD, RETRO, INVRT, ADD CONSTANT ]

C  SEG FUNCS MAY BE 'SMOOTHED' BUT THIS FEATURE AND 'CRUNCH' SHOULD 
C  BE USED SPARINGLY AS ALL 512 WDS OF THE ARRAY MUST BE SAVED.  THIS
C  CLUTTERS UP THE DSK.

C  'C' FOR "ALTER OR FINISH?" WILL JUMP DIRECTLY TO "CRUNCH" MODE.
C    BUT ONCE CHANGED BY 'CRUNCH' THIS UNSTORED ORIG. IS LOST.
C'SP'(FOR "SEE")PLOTS ONE FUNC. (SA=PLOT ALL); 'SL' PUTS IT OUT ON
C  THE LPT.

C FOR EXPONENTIALS GET INTO 'SEG'.  TYPE 'X', DECAY FAC, N.  IF 
C  N IS NON-ZERO THE FUNCTION WILL NOT! NORMALIZE (IE. NOT GO TO 0).
C  AFTER A FILE HAS BEEN READ IN,
C  THE DECAY FAC. IS THE NUM ALONGTHE SCALE(1-100) WHERE THE CURVE
C  SEEMS TO TOUCH ZERO. (WILL ALWAYS HIT 0 AT END UNLESS N.NE.0.)

C  <CR> FOR 'TYPE FILE' WILL HOLD ON TO IT.
	COMMON/S/H,AMP,CON,PH
	COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
	1,LX,JX,JT,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
	COMMON FUNC(512),F2(512),K,I
	COMMON/LT/LPTY,JSEE
	DIMENSION RF(4)
21	FORMAT(' A=ALTER, F=FINISH '$)
22	FORMAT(' NEW FUNC, EDIT, CRUNCH, DELETE, RENAME, SEE?   '$)
23	FORMAT(' SEG OR SYNTH?   '$)
25	FORMAT(' TYPE FILE NAME   '$)
26	FORMAT(I3,') TYPE AMPL, STEP#  '$)
C  'X' HERE WILL MAKE EXPON. FUNC.
28	FORMAT(' 0=NORM,OR H,A,P,K   '$)
280	FORMAT(
	1' UP TO 10 FUNCTIONS MAY BE STORED IN EACH FILE'/
	1' TYPE "B" TO BACKUP AT ANY TIME'//)
30	FORMAT(8F)
31	FORMAT(1XA5,A1,5A5/)
35	FORMAT(1XA5,'IN FILE "',A5,'.FUN"'/)
37	FORMAT(8F9.3)
371	FORMAT(I3,') ',4F8.2)
372	FORMAT(A1,21F)
38	FORMAT(2(A5,A1),23A2)
40	FORMAT(11(A1,A3))
41	FORMAT(' ADD TO AN EXISTING FILE?   '$)
42	FORMAT(' WHICH FUNC?   '$)
47	FORMAT(
	1' <CR>=EXIT,   C=CHNG (LN#, CHNGS),'/' I=INSRT, (AMP, STP) 
	1D=DEL (LN#) '$)
48	FORMAT(' X  N (=DECAY FAC.) FOR XPONTLS')
	CALL ILL  
C!***** STOPS ILLEGAL CHAR. LOSSAGE
2281	TYPE 280
281	KZ=0
	JSEE=0
	LPTY=5
C   USED IN RELATIVE VECTOR ROUTINE
	Z=0
	EY=0
	ICUR=0
	XP=0
	KT=0
	FNUM=0
	OLD=0
	FNUM1=0
	TYPE 22
	ACCEPT 40,ON,P
	PLTALL=0
	IF(P.EQ.'A')GO TO 3280
	IF(P.NE.'X')GO TO 1281
3280	PLTALL=-1
1281	IPLOT=0
	XDPY=-1
	IF(ON.EQ.'N')GO TO 1000
	IF(ON.EQ.'E')GO TO 100
	IF(ON.EQ.'R')GO TO 100
	IF(ON.EQ.'D')GO TO 100
	IF(ON.EQ.'C')GO TO 100
	IF(ON.EQ.'S')GO TO 100
	IF(P.EQ.'A'.OR.P.EQ.'X')PLTALL=-1
CC 7/74 COLGATE	ON=ONX
C ---OUT 7/74---  RETURNS FOR MORE "SEE"
CC 7/74 COLGATE	GO TO 4281
	GO TO 281
C  WON'T GO ON IF BLANK
100	ONX=ON
	TYPE 25
	OLD=-1
	ACCEPT 38,FLNM1
	IF(FLNM1.EQ.' ')FLNM1=FLNM
	IF(FLNM1.EQ.0)GO TO 100
	IF(LOOKF(FLNM1).EQ.0)GO TO 100
	IF(FLNM.NE.FLNM1)GO TO 2151
	OLD=0
4281	TYPE 40,B
	IF(PLTALL)GO TO 5402
	GO TO 1402
2151	FLNM=FLNM1
	CALL READ1
3402	LX=0
	TYPE 40,B
	IF(PLTALL)GO TO 402
C  "SA" WILL PLOT ALL FUNCS IN FILE
	JX=-1
	IF(B(1,2).NE.' ')GO TO 1402
	FNUM1=B(2,1)
C  ONLY ONE FUNC IN FILE.
	GO TO 402
1402	TYPE 42
	ACCEPT 40,BU
	IF(BU.EQ.' ')GO TO 1402
	IF(BU.NE.'B')GO TO 380
	FLNM=0
	JX=0
	GO TO 281
380	REREAD 38,FNUM1
	IDEL=0
C  LX IS MAIN COUNTER
	IF(OLD)GO TO 402
	DO 1302 JX=1,10
1302	IF(FNUM1.EQ.FN(JX))GO TO 5402
CC 7/74 WHY WAS THIS HERE????	GO TO 3402
	GO TO 100
2202	CALL DPYF(-1,FUNC)
C  -1 SUPRESSES DISPLAY
	IF(P.EQ.'P'.OR.P.EQ.'A'.OR.P.EQ.0)GO TO 70
2203	LPTY=3
	JSEE=-1
	CALL DPY(FUNC,1)
	CALL RESET
	GO TO 2281
70	CALL PLOTIT(FUNC,XA(JX),P)
	IF(P.EQ.'P')GO TO 2281
	JX=JX+1
	IF(B(2,JX).NE.' '.AND.JX.LE.10)GO TO 2202
CC***	GO TO 2281
	CALL EXIT
402	CALL READER
	IF(JX)GO TO 100
C 6/74  GO BACK IF IT DIDN'T FIND THE FUNC NAME IN THIS FILE.
C  AT THIS POINT LX=TOTAL FUNCS+1
5402	IF(PLTALL)JX=1
1202	IF(ON.EQ.'C')GO TO 3202
	IF(ON.EQ.'S')GO TO 3202
	IF(ON.NE.'D')GO TO 3281
3202	CALL DPYF(JX,FUNC)
	IF(P.EQ.'L')GO TO 2203  
C!**** SL PLOTS ON LPT.
	IF(PLTALL)GO TO 2202
	IF(P.EQ.'P')GO TO 2202
	IF(P.EQ.0)GO TO 2202
	IF(ON.EQ.'S')GO TO 2281
	IF(ON.EQ.'C')GO TO 1201
1140	TYPE 1139
	ACCEPT 40,IDEL
	IF(IDEL.EQ.'N')GO TO 2281
	IF(IDEL.NE.'Y')GO TO 1140
	IDEL=JX
	LX=LX-1
C  NOW LX=TOTAL # OF FUNCS.
	CALL WRIFUN
1139	FORMAT(' DELETE IT? ',$)
CC2202	CALL PLOTIT(FUNC,XA(JX),P)
CC	IF(P.EQ.'P')GO TO 2281
CC	JX=JX+1
CC	IF(B(2,JX).NE.' '.AND.JX.LE.10)GO TO 1202
CCC  "SA" KEEPS PLOTTING UNTIL NO MORE ARE FOUND
CC	GO TO 2281
3281	X=' '
	TYPE 31,XA(JX),X,FN(JX)
	JT=4
	IF(XA(JX).EQ.'SEG')JT=2
	KZ=1
	DO 137	K=1,50
	KZ=KZ+1
	DO 138 L=1,JT
138	A(K,L)=AA(L,K,JX)
	IF(A(K,1).EQ.999)GO TO 4401
137	IF(A(K,2).GE.100)GO TO 4401

4401	Z=-1
	IF(A(K,2).LE.100)GO TO 4403
	IF(K.GT.1)GO TO 4404
	CALL DPYF(JX,FUNC)
	IF(ON.EQ.'R')GO TO 3032
	TYPE 4405
	A(1,2)=520
	GO TO 4201
4404	TYPE 4402
4403	IF(JT.EQ.2)EY='EG'
	GO TO 1032
4402	FORMAT('  IT WAS SMOOTHED.')
4405	FORMAT(' CANNOT EDIT CRUNCHED FUNCS.'/)
1000	TYPE 23
	ACCEPT 40,BU
	IF(BU.EQ.'B')GO TO 281
	REREAD 40,X,EY
1032	CALL ZERO(FUNC)
C  CLEARS THE FUNC.
	ISMOO=0
	IF(EY.EQ.'EG')GO TO 800
151	EY=0
	JT=4
C  FOR WRIFUN
15	KT=1
104	IF(Z.EQ.-1)GO TO 102
	IF(KT.LT.KZ)GO TO 102
	IF(Z.EQ.1)GO TO 2032
1041	KZ=0
	TYPE 28
	Z=0
	ACCEPT 40,BU
	IF(BU.EQ.'B')GO TO 509
	REREAD 30,(A(KT,K),K=1,4)
C ACCEPT HARM,AMPL,PHASE,KONSTANT(IF K>100, MULTIPLIES WAVE *(K-100))
102	H=A(KT,1)
	IF(H.EQ.0)GO TO 2200
	IF(H.EQ.999.)GO TO 2200
C   999 ENDS 'READIN' SYNTHS
	IF(Z.GT.0)TYPE 371,KT,(A(KT,K),K=1,4)
	AMP=A(KT,2)
	PH=A(KT,3)
	CON=A(KT,4)
	CALL SYN(FUNC)
	KT=KT+1
	IF(KZ.LE.KT)CALL DPY(FUNC,1)
	GO TO 104
2201	IF(JT.NE.2)GO TO 1201
	IF(A(KT-1,2).GT.100)GO TO 1201
C  TO USE CURRENT FUNC IN CRUNCH
	IF(LX.GT.10)GO TO 204
	CALL STORE(10)
C  PUTS FROM A ARRAY TO AA ARRAY
C?????	XA(K)='SEG'
CC 6/74 COLGATE--SEE ALSO FUSUB 	CALL DPYF(K,FUNC)
	CALL DPYF(10,FUNC)
1201	CALL ZFUNC
C  THIS WILL BE FOR SPECIAL FEATURE PACKAGE
	IF(KT.EQ.512)GO TO 2281
C  FOR BACKUP
4201	EY='EG'
	KT=2
	GO TO 900
2200	IF(KT.LE.1)GO TO 509
C  7/74 COLGATE  BACKUP IF NO INPUT TO SYNTH
CC2200	CALL NORM(FUNC)
	CALL NORM(FUNC)
C   NORMALIZES THE FUNCTION
201	CALL DPY(FUNC,1)
	IF(BU.EQ.'A')GO TO 2032
	IF(ON.EQ.'R')GO TO 3032
204	TYPE 21
	IF(EY.EQ.'EG')TYPE 271
C   CHANGE IT?
	ACCEPT 40,BU
	IF(BU.EQ.'A')GO TO 210
	IF(BU.EQ.'F')GO TO 900
	IF(BU.EQ.'S')GO TO 7000
	IF(BU.EQ.'C')GO TO 2201
C  TO USE CURRENT FUNC IN CRUNCH
	IF(BU.NE.'B')GO TO 2032
	IF(EY.EQ.'EG')GO TO 509
	GO TO 5091
C   NEXT IS FOR ALTERS ('A' OR <CR>)
2032	TYPE 47
	ACCEPT 40,K
	REREAD 372,L,X,RF
	IF(X.NE.0)GO TO 211
	IF(RF(1).NE.0)GO TO 211
	IF(EY.EQ.'EG')GO TO 204
	BU=0
	GO TO 1041
211	L=X
	IF(K.EQ.'I')GO TO 212
	IF(K.NE.'D')GO TO 205
C   JUMP IF NO DELETE
	KT=KT-1
	DO 209 K=L,KT
	DO 209 J=1,4
209	A(K,J)=A(K+1,J)
	GO TO 210
205	X=RF(2)
	IF(EY.NE.'EG')GO TO 1207
	IF(X.NE.0)GO TO 1205
	X=A(L,2)
	RF(2)=X
C TYPE JUST AMPL. TO CHANGE IT ONLY. (STEP 0 =SAME STEP AS BEFORE.)
1205	IF(X.LT.A(L+1,2))GO TO 208
	IF(L.LT.KT-1)GO TO 2032
	GO TO 208
212	L=1
	H=X
	IF(EY.NE.'EG')GO TO 4212
	L=L+1
	H=RF(1)
4212	DO 1212 K=1,KT
1212	IF(H.GE.A(K,L))GO TO 2212
C NOW WE KNOW WHERE TO MAKE THE INSERT
CIRC2212	DO 3212 L=KT+1,2,-1
CIRC3212	RF(L)=RF(L-1)
CC212	IF(RF(2).NE.0)GO TO 213
2212	RF(2)=RF(1)
	RF(1)=X
	L=KT
213	IF(EY.NE.'EG')GO TO 214
	X=RF(2)
	DO 215 K=1,KT
	Y=A(K,2)
	IF(X.GT.Y)GO TO 215
C   JUMP IF NOT PAST STEP NUM.
	L=K
	IF(X.EQ.Y)GO TO 208
C   IF STEP=ANOTHER STEP, IT WORKS LIKE 'C'HANGE.
	GO TO 214
215	CONTINUE
214	KT=KT+1
	DO 206 K=KT,L,-1
	DO 206 J=1,4
206	A(K,J)=A(K-1,J)
	GO TO 207
C   TO TYPE OLD NUMBERS
208	IF(X.GT.A(L-1,2))GO TO 1207
	IF(L.GT.1)GO TO 2032
1207	TYPE 371,L,(A(L,K),K=1,4)
207	DO 202 K=1,4
202	A(L,K)=RF(K)
210	KZ=KT
	Z=1
	GO TO 1032
271	FORMAT('+S=SMOOTH  '$)
C  FOR RENAMES
3032	Z=-1
	GO TO 901
900	TYPE 41
C  ADD TO EXISTING FILE
	ISKP=0
	ACCEPT 40,Z
9000	IF(Z.EQ.'B')GO TO 204
	IF(Z.EQ.'Y')GO TO 9001
	IF(Z.NE.'N')GO TO 900
9001	TYPE 25
	ACCEPT 38,FLNM
	IF(FLNM.NE.' ')GO TO 9002
	IF(FLNM1.NE.' ')FLNM=FLNM1
9002	IF(FLNM.EQ.'B')GO TO 204
	IF(FLNM.EQ.' ')GO TO 204
CC	IF(LOOKF(FLNM).AND.Z.EQ.'N')GO TO 902
	IF(LOOKF(FLNM))GO TO 902
	IF(Z.NE.'N')GO TO 900
C  LOOKF CHECKS ON LOOK-UP  FOR NAME.FUN
901	JT=4
	IF(EY.EQ.'EG')JT=2
	IDEL=0
	CALL WRIFUN
	GO TO 900
C  COMES BACK IF NO ROOM IN FILE FOR NEW FUNC.

902	IF(Z.NE.'N')GO TO 901
	TYPE 381,FLNM
	ACCEPT 40,Z
	IF(Z.EQ.'Y')GO TO 903
	GO TO 9000
903	Z='N'
	GO TO 901
C  7/74 COLGATE  NOW WILL REALLY WRITE OVER A FILE!
381	FORMAT(/9X'WRITE OVER ',A5,'.FUN?  ',$)
161	DO 261 K=1,512
261	FUNC(K)=EXP((1-K)/STEP)
	KT=2
	XP=-1
	IF(H.NE.0)GO TO 7009
C  H}0 = NO NORMALIZATION OF XPONTL
	X=FUNC(512)
	DO 361 K=1,512
361	FUNC(K)=FUNC(K)-(K-1)/511.*X
	GO TO 7009
800	IF(XP)GO TO 510
	X=0
	IK=0
	JT=2
C  JT AND EY SEEM TO PERFORM THE SAME FUNCTIONS??
	Y=0
	KT=1
504	IF(KT.GE.KZ)GO TO 510
	AMP=A(KT,1)
5008	STEP=A(KT,2)
	IF(STEP.LE.A(KT-1,2).AND.KT.GT.1)GO TO 509
C   SO IT CAN'T GO BACKWARDS
	GO TO 5071
611	FORMAT(' NO MORE THAN 50 SEGS'/)
610	TYPE 611
509	KT=KT-1
5091	IF(KT.LT.1)GO TO 281
	GO TO 210
510	IF(KT.EQ.1)TYPE 48
	TYPE 26,KT
	KZ=0
CX	ACCEPT 40,BU
	ACCEPT 372,BU,STEP,H
	IF(BU.EQ.'B')GO TO 509
61	REREAD 30,AMP,STEP,H
	IF(STEP.LT.1)STEP=1
	IF(BU.EQ.'X')GO TO 161
C  TYPE 'X' FOR EXPON. FUNC. + DECAY FACTOR, +1 = NO NORM.
C  WE START WITH STEP 1 (NOT 0)
5071	IF(KT.GT.50)GO TO 610
C   TOO MANY SEGS
	IF(Z.GT.0)TYPE 371,KT,AMP,STEP
	IF(STEP.GT.100)STEP=100
CX	STPS=STEP-X
CX	IF(STPS.LE.0.AND.KT.NE.1)GO TO 504
C   SO IT CAN'T BACKUP HERE
CX	IS=STPS
CX	IF(STEP.LE.1.)Y=AMP
CC COLGATE 6/74	DIF=(AMP-Y)/STPS
CX	IF(IS.NE.0)DIF=(AMP-Y)/STPS
CX	IJ=STPS*5.12
CX203	DO 2031 K=1,IJ
CX2031	FUNC(K+IK)=Y+DIF*K/5.12
C   100 STEPS ARE CONVERTED HERE TO 512
CX	IK=IK+IJ
CX12	Y=AMP
CX	X=STEP
CX	A(KT,1)=Y
CX	A(KT,2)=X
	DIF=AMP-Y
	IF(STEP-X.GT.0)GO TO 9003
	IF(KT.NE.1)GO TO 504
C   SO IT CAN'T BACKUP HERE
9003	IF(STEP.LE.1.)Y=AMP
	STPS=STEP-X
	IS=STPS
	IF(STEP.LE.1.)Y=AMP
CC COLGATE 6/74	DIF=(AMP-Y)/STPS
	IF(IS.NE.0)DIF=(AMP-Y)/STPS
	IJ=STPS*5.12
	DO 2031 K=1,IJ
2031	FUNC(K+IK)=Y+DIF*K/5.12
C   100 STEPS ARE CONVERTED HERE TO 512
	IK=IK+IJ
203	YSTP=STEP
	IF(YSTP.GT.1)GO TO 12
	YSTP=0
12	Y=AMP
	X=YSTP
	IF(KT.GT.1)GO TO 404
	IF(STEP.LE.1)GO TO 404
C  PUTS 0,0 IN IF 1ST STEP IS NOT 1 OR 0
	A(1,1)=0
	A(1,2)=0
	KT=2
404	A(KT,1)=Y
CC	A(KT,2)=X
	A(KT,2)=STEP
7001	KT=KT+1
C   KT COUNTS SEGMENTS
	IF(STEP.LT.100)GO TO 504
	GO TO 201


7000	IF(ISMOO)GO TO 201
	IF(KT.LE.20)GO TO 7007
	TYPE 7008
	GO TO 509
7008	FORMAT(' NO MORE THAN 20 SEGS IN CURVES'/)
7007	CALL SSS(A,KT-1,FUNC)
C   DRAWS GRID 2
7009	A(KT-1,2)=520
	ISMOO=-1
C  SO YOU CAN'T COME BACK 2 TIMES
	GO TO 201
	END

	SUBROUTINE WRIFUN
	COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
	1,LX,JX,J,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
	COMMON FUNC(512),F2(512),K,I
 	DATA ARY/'ARRAY'/,R999/999.0/,MX/' '/
24	FORMAT(' TYPE FUNCTION NAME   '$)
34	FORMAT(A5,'(',A5,');',A5)
35	FORMAT(1XA5,'IN FILE "',A5,'.FUN"'/)
37	FORMAT(8F10.4)
39	FORMAT(A5,10(A1,A3))
391	FORMAT(A3)
390	FORMAT(A1)
43	FORMAT(' NO ROOM IN FILE  "',A5,'.FUN"')
44	FORMAT(' FUNCTIONS ALREADY IN FILE - ',A5)
45	FORMAT('(512);')

CX	MX=0
	IF(IDEL.NE.0)GO TO 292
C  FOR DELETIONS
	IF(Z.EQ.'N')GO TO 912
	IF(FLNM.EQ.FLNM1)GO TO 1922
C  JUMP IF THAT FILE IS NOW IN CORE
	FLNM1=0
C  ↑↑↑↑↑↑ TO GUARD AGAINST CONFUSION IN BACKUPS.
	CALL READ1
1922	IF(Z.EQ.'N')GO TO 912
CC COLGATE 7/741922	TYPE 44,FLNM
	TYPE 44,FLNM
C  FUNCS. IN FILE
	TYPE 39,MX,B
912	TYPE 24
	ACCEPT 390,FNUM
	IF(FNUM.EQ.'B')RETURN
C  FOR BACKUP
	IF(FNUM.EQ.' ')GO TO 1922
	REREAD 391,FNUM
	IF(Z.EQ.'N')GO TO 911
	IF(Z.NE.-1)GO TO 90
C JUMP IF .NE. 'RENAME'
C 7/74 COLGATE
	DO 30 K=1,LX-1
	IF(K.EQ.JX.OR.FN(K).NE.FNUM)GO TO 30
	TYPE 31
	CALL EXIT
31	FORMAT(/' FUNC NAME IN USE!')
30	CONTINUE
	B(2,JX)=FNUM
	FN(JX)=FNUM
	LX=LX-1
	GO TO 1906
90	IF(FLNM.EQ.FLNM1)GO TO 1090
	FNUM1=0
	LX=0
C  TO PUT NEW FUNC IN OLD FILE
	CALL READER
1090	JX=0
	DO 20 K=1,LX-1
	IF(FNUM.NE.FN(K))GO TO 20
	JX=K
	LX=LX-1
	GO TO 21
20	CONTINUE
210	JX=LX
C  JX=LX IF FNUM WAS NOT FOUND
	IF(JX.GT.10)GO TO 193
21	FN(JX)=FNUM
	X='SEG'
	IF(J.EQ.4)X='SYNTH'
	XA(JX)=X
	CALL STORE(JX)
	IF(J.EQ.2)GO TO 1192
	AA(1,KT,JX)=999
	GO TO 192
1192	IF(A(KT-1,2).EQ.100)GO TO 192
C  JUMP IF NO SMOOTHING
	DO 2192 K=1,512
2192	AA(K,KT,JX)=FUNC(K)

192	IF(JX.NE.1)B(1,JX)=','
	B(2,JX)=FNUM
	GO TO 1906
193	TYPE 43,FLNM
C  NO ROOM IN FILE.
	RETURN
C  NEW FILE
911	LX=1
	DO 94 K=1,20
94	B(K,1)=' '
	GO TO 210
C  CLEARS B FOR NEW, SINGLE ITEM.
292	IF(IDEL.EQ.10)GO TO 932
	DO 931 K=IDEL,LX-1
931	B(2,K)=B(2,K+1)
932	B(1,LX)=' '
	B(2,LX)=' '
1906	REWIND 1
	IF(Z.EQ.'N'.OR.IDEL.GT.0)GO TO 22
	DO 25 K=1,LX
	IF(K.GT.1.AND.B(1,K).NE.',')GO TO 26
	X=B(2,K)
	IF(X.NE.' '.AND.X.EQ.FN(K))GO TO 25
26	TYPE 23
	RETURN
23	FORMAT(/' CONFUSION IN THIS FILE. TRY ANOTHER! '/)
25	CONTINUE
CX22	CALL FORNAM(FLNM,'FUN')
C  WRITES FILE WITH EXTENSION .FUN
22	REWIND 1
	CALL OFILE(1,FLNM,'.FUN')
CX  USES MY OFILE ROUTINE !!!!!
CC  NOT YET! 22	CALL OFLE(1,FLNM,'.FUN')
C  COLGATE OFILE REPLACEMENT.  ALL FUNC FILES WILL BE '.FUN'.
	WRITE(1,39),ARY,B
	WRITE(1,45)
69	NX=0
1905	IF(NX.EQ.LX)GO TO 904
C  LX=TOTAL # OF FUNCS
	NX=NX+1
	IF(IDEL.EQ.NX)GO TO 1905
C  SO THAT DATA MUST ALWAYS BE READ FROM DSK AFTER A DEL.
1	J=4
	X='   99'
	IF(XA(NX).NE.'SEG')GO TO 68
	J=2
	X=' '
68	WRITE(1,34),XA(NX),FN(NX),X
	JX=0
2905	JX=JX+1
	IF(J.EQ.2)GO TO 3905
	IF(AA(1,JX,NX).EQ.999)GO TO 5905
C  FOUND END OF A SYNTH
	WRITE(1,37),(AA(K,JX,NX),K=1,4)
	GO TO 2905
5905	WRITE(1,37)R999
	GO TO 1905
3905	X=AA(2,JX,NX)
	WRITE(1,37),AA(1,JX,NX),X
	IF(X.EQ.100)GO TO 1905
C  FOUND END OF A SEG
	IF(X.LT.100)GO TO 2905
	WRITE(1,37)(AA(K,JX+1,NX),K=1,512)
	GO TO 1905
904	TYPE 39,MX,B
	IF(IDEL.EQ.0)TYPE 35,FNUM,FLNM
	IF(IDEL.NE.0)FLNM=0
	LX=LX+1
C  FOR RESTARTS
	CALL EXIT
	END